| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Ни как не могу убрать мерцание картинки! [D7, Win95/98, WinXP]

Страницы:   < 1 2 >

Нулевой ©   (2006-12-24 19:56:00) 

Если не глядеть на мерцание (что не реально) вроде "все" работает! Создается Bitmap, на нем Image. Я конечно вижу много вызовов Paint, но куда бех них. Может есть способ обновить сам фон, под картинкой.
Помогите, скажите как побороть! Код (часть):

procedure TPngLVButton.Paint;
var
 BtnBmp: TBitmap;
 CaptionRect: TRect;
 PngImgLeft, PngImgTop, TextTop, TextLeft, TextWidth, TextHeight: integer;
 FaceColor, GradColor, LightColor, DarkColor, BorderColor, TextColor: TColor;
 //--- +
 PaintRect: TRect;
 //--- end
begin
 BtnBmp := TBitmap.Create;
 BtnBmp.Width := Width;
 BtnBmp.Height := Height;

 case FBtnState of
   bsNormal:
     begin
       FaceColor := FColorFace;
       GradColor := FColorGrad;
       LightColor := FColorLight;
       DarkColor := FColorDark;
       BorderColor := FColorBorder;
       TextColor := FColorText;
     end;

   bsOver:
     begin
       FaceColor := FOverColorFace;
       GradColor := FOverColorGrad;
       LightColor := FOverColorLight;
       DarkColor := FOverColorDark;
       BorderColor := FOverColorBorder;
       TextColor := FOverColorText;
     end;

   bsDown:
     begin
       FaceColor := FDownColorFace;
       GradColor := FDownColorGrad;
       LightColor := FDownColorLight;
       DarkColor := FDownColorDark;
       BorderColor := FDownColorBorder;
       TextColor := FDownColorText;
     end;
   //--- +
 else
   begin
     FaceColor := FColorFace;
     GradColor := FColorGrad;
     LightColor := FColorLight;
     DarkColor := FColorDark;
     BorderColor := FColorBorder;
     TextColor := FColorText;
   end;
   //--- end
 end;
 if not Enabled then
 begin
   FaceColor := FDisabledColorFace;
   GradColor := FDisabledColorGrad;
   LightColor := FDisabledColorLight;
   DarkColor := FDisabledColorDark;
   BorderColor := FDisabledColorBorder;
   TextColor := FDisabledColorText;
 end;

 with BtnBmp.Canvas do
 begin
   Brush.Color := FaceColor;
   Brush.Style := bsSolid;
   Rectangle(0, 0, Width, Height);
 end;

 if FGradient then
 begin
   GradientFillRect(BtnBmp.Canvas, Rect(0, 0, Width, Height), FaceColor, GradColor);
 end;

 BtnBmp.Canvas.Font := Font;
 BtnBmp.Canvas.Font.Color := TextColor;
 TextWidth := BtnBmp.Canvas.TextWidth(Caption);
 TextHeight := BtnBmp.Canvas.TextHeight(Caption);
 TextTop := (Height - TextHeight) div 2;
 TextLeft := (Width - TextWidth) div 2;

 //--- +
 if not PngImage.Empty then
 begin
   //Calculate the position of the PNG glyph
   begin
     PngImgLeft := 0;
     case FLayout of
       blGlyphLeft:
         begin
           PngImgTop := (Height - FPngImage.Height) div 2;
           PngImgLeft := TextLeft - FPngImage.Width div 2;
           inc(TextLeft, FPngImage.Width div 2);
           if not (Caption = '') then
           begin
             PngImgLeft := PngImgLeft - FSpacing div 2 - FSpacing mod 2;
             inc(TextLeft, FSpacing div 2);
           end;
         end;
       blGlyphRight:
         begin
           PngImgTop := (Height - FPngImage.Height) div 2;
           PngImgLeft := TextLeft + TextWidth - FPngImage.Width div 2;
           inc(TextLeft, -FPNGImage.Width div 2);
           if not (Caption = '') then
           begin
             PngImgLeft := PngImgLeft + FSpacing div 2 + FSpacing mod 2;
             inc(TextLeft, -FSpacing div 2);
           end;
         end;
       blGlyphTop:
         begin
           PngImgLeft := (Width - FPngImage.Width) div 2;
           PngImgTop := TextTop - FPngImage.Height div 2 - FPngImage.Height mod 2;
           inc(TextTop, FPngImage.Height div 2);
           if not (Caption = '') then
           begin
             PngImgTop := PngImgTop - FSpacing div 2 - FSpacing mod 2;
             inc(TextTop, +FSpacing div 2);
           end;
         end;
       blGlyphBottom:
         begin
           PngImgLeft := (Width - FPngImage.Width) div 2;
           PngImgTop := TextTop + TextHeight - FPngImage.Height div 2;
           inc(TextTop, -FPngImage.Height div 2);
           if not (Caption = '') then
           begin
             PngImgTop := PngImgTop + FSpacing div 2 + FSpacing mod 2;
             inc(TextTop, -FSpacing div 2);
           end;
         end;
     else
       PngImgTop := (Height - FPngImage.Height) div 2; //--- +
     end;

     if FBtnState = bsDown then
     begin
       inc(PngImgTop);
       inc(PngImgLeft);
     end;
   end;
   PaintRect := Rect(PngImgLeft, PngImgTop, PngImgLeft + FPngImage.Width, PngImgTop +
     FPngImage.Height);
 end;
 //--- end

 if FBtnState = bsDown then
 begin
   inc(TextTop);
   inc(TextLeft);
 end;
 with CaptionRect do
 begin
   Top := TextTop;
   Left := TextLeft;
   Right := Left + TextWidth;
   Bottom := Top + TextHeight;
 end;

 if Caption <> '' then
 begin
   BtnBmp.Canvas.Brush.Style := bsClear;
   DrawText(BtnBmp.Canvas.Handle,
     PChar(Caption),
     length(Caption),
     CaptionRect,
     DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOCLIP);
 end;

 with BtnBmp.Canvas do
 begin
   Pen.Style := psSolid;
   Brush.Color := FaceColor;
   Pen.Color := BorderColor;
   Brush.Style := bsClear;
   Rectangle(0, 0, Width, Height);

   if Ctl3D then
   begin
     Pen.Color := LightColor;
     MoveTo(1, Height - 2);
     LineTo(1, 1);
     LineTo(Width - 1, 1);

     Pen.Color := DarkColor;
     MoveTo(Width - 2, 1);
     LineTo(Width - 2, Height - 2);
     LineTo(1, Height - 2);
   end;
 end;

 if FFocused then
 begin
   //--- + местами
   BtnBmp.Canvas.Pen.Width := 2;
   BtnBmp.Canvas.Pen.Color := FColorBorder;
   BtnBmp.Canvas.Brush.Style := bsClear;
   BtnBmp.Canvas.Rectangle(1, 1, Width, Height);

   BtnBmp.Canvas.Pen.Width := 1;
   BtnBmp.Canvas.Pen.Color := clWhite;
   BtnBmp.Canvas.Brush.Style := bsClear;
   BtnBmp.Canvas.Rectangle(2, 2, Width - 2, Height - 2);

   BtnBmp.Canvas.Pen.Width := 1;
   BtnBmp.Canvas.Pen.Color := FColorFocusRect;
   BtnBmp.Canvas.Brush.Style := bsClear;
   BtnBmp.Canvas.Rectangle(3, 3, Width - 3, Height - 3);

   //--- end
 end;
 Canvas.Draw(0, 0, BtnBmp);
 BtnBmp.Free;
 //--- +
 if not PngImage.Empty then
 begin
   if Enabled then
     DrawPNG(FPngImage, Canvas, PaintRect, [])
   else
     DrawPNG(FPngImage, Canvas, PaintRect, FPngOptions);
 end;
 //--- end
end;


---

Нулевой   (2006-12-24 19:57:00) [21]

...

constructor TPngLVButton.Create(AOwner: TComponent);
begin
 inherited;
 Width := 75;
 Height := 25;
 FCtl3D := True;
 FGradient := False;
 TabStop := True;
 FSpacing := 4;
 FCancel := False;
 FDefault := False;
 FHotTrack := False;
 ColorScheme := cs71LVNet;
 FClicked := False;
 FOverColorGrad := $00C8D0D4;
 FDownColorGrad := $00C8D0D4;
 FDisabledColorGrad := $00C8D0D4;
 //--- +
 FPngImage := TPNGObject.Create;
 FPngOptions := [pngBlendOnDisabled];
 FImageFromAction := False;
 FMargin := -1;
 //DoubleBuffered := true;
 //ControlStyle := ControlStyle + [csOpaque];
 //--- end
end;

destructor TPngLVButton.Destroy;
begin
 FPngImage.Free; //--- +
 inherited Destroy;
end;

procedure TPngLVButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
 inherited ActionChange(Sender, CheckDefaults);
 if Sender is TCustomAction then
   with TCustomAction(Sender) do
   begin
     //Copy image from action's imagelist
     if (PngImage.Empty or FImageFromAction) and (ActionList <> nil) and
       (ActionList.Images <> nil) and (ImageIndex >= 0) and (ImageIndex <
       ActionList.Images.Count) then
     begin
       CopyImageFromImageList(FPngImage, ActionList.Images, ImageIndex);
       FImageFromAction := True;
     end;
   end;
end;

procedure TPngLVButton.Click;
begin
 if Parent <> nil then
   GetParentForm(self).ModalResult := ModalResult;
 FBtnState := bsNormal;
 //Paint;
 inherited;
end;

procedure TPngLVButton.MouseEnter(var msg: TMessage);
begin
 if csDesigning in ComponentState then
   exit;
 if not FHotTrack then
   exit;
 if FClicked then
   FBtnState := bsDown
 else
   FBtnState := bsOver;
 Paint;
end;

procedure TPngLVButton.MouseLeave(var msg: TMessage);
begin
 inherited;
 if not FHotTrack then
   exit;
 FBtnState := bsNormal;
 Paint;
end;

procedure TPngLVButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:
 Integer);
begin
 inherited;
 if Button <> mbLeft then
   Exit;
 FClicked := True;
 FBtnState := bsDown;
 if TabStop then
   SetFocus;
 Paint;
end;

procedure TPngLVButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y:
 Integer);
begin
 inherited;
 FClicked := False;
 if (x > 0) and (y > 0) and (x < width) and (y < height) then
   if FHotTrack then
     FBtnState := bsOver
   else
     FBtnState := bsNormal;
 Paint;
end;

procedure TPngLVButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
 inherited;
end;

procedure TPngLVButton.WMSetFocus(var msg: TWMSetFocus);
begin
 FFocused := true;
 Paint;
end;

procedure TPngLVButton.WMKillFocus(var msg: TWMKillFocus);
begin
 FFocused := false;
 FBtnState := bsNormal;
 Paint;
end;

procedure TPngLVButton.WMKeyDown(var msg: TWMKeyDown);
begin
 if msg.CharCode = VK_SPACE then
   FBtnState := bsDown;
 if msg.CharCode = VK_RETURN then
   Click;
 Paint;
end;

procedure TPngLVButton.WMKeyUp(var msg: TWMKeyUp);
begin
 if (msg.CharCode = VK_SPACE) then
 begin
   FBtnState := bsNormal;
   Paint;
   Click;
 end;
end;

...

---

Страницы:   < 1 2 >

Наверх