frxctrls.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

  Text:array[0..255] of Char;
begin
 if odSelected in State then
 begin
   frFontViewForm.FPanel.Caption:=self.Items[index];
   frFontViewForm.FPanel.Font.Name:=self.Items[index];
 end;
 with Canvas do
 begin
   BmpWidth:= 15;
   FillRect(Rect);
   if (Integer(Items.Objects[Index]) and TRUETYPE_FONTTYPE)<>0 then
     Bitmap:= FTrueTypeBMP
   else Bitmap:= nil;
   if Bitmap<>nil then
   begin
     BmpWidth:= Bitmap.Width;
     BrushCopy(Bounds(Rect.Left+1 , (Rect.Top+Rect.Bottom-Bitmap.Height)
       div 2, Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
       Bitmap.Height), Bitmap.TransparentColor);
   end;
   StrPCopy(Text, Items[Index]);
   Rect.Left:= Rect.Left+BmpWidth+2;
   DrawText(Canvas.Handle, Text, StrLen(Text), Rect,
{$IFDEF Delphi4}
   DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX));
{$ELSE}
   DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
{$ENDIF}
   if (Index = Numused) then
   begin
     Pen.Color:= clBtnShadow;
     MoveTo(0,Rect.Bottom-2);
     LineTo(width, Rect.Bottom-2);
   end;
   if (Index = Numused+1) and (Numused<>-1) then
   begin
     Pen.Color:= clBtnShadow;
     MoveTo(0, Rect.Top);
     LineTo(width, Rect.Top);
   end;
 end;
end;

procedure TfrxFontComboBox.CMFontChanged(var Message:TMessage);
begin
  inherited;
  Init;
end;

procedure TfrxFontComboBox.CMFontChange(var Message:TMessage);
begin
  inherited;
  Reset;
end;

procedure TfrxFontComboBox.Init;
begin
  if GetFontHeight(Font) > FTrueTypeBMP.Height then
    ItemHeight:= GetFontHeight(Font)
  else
    ItemHeight:= FTrueTypeBMP.Height+1;
  RecreateWnd;
end;

procedure TfrxFontComboBox.Click;
begin
 inherited Click;
 if not (csReading in ComponentState) then
   if not FUpdate and Assigned(FOnClick) then FOnClick(Self);
end;

procedure TfrxFontComboBox.Reset;
begin
  if csDesigning in ComponentState then exit;
  FUpdate:= True;
  try
    PopulateList;
    if Items.IndexOf(Text) =-1 then
      ItemIndex:= 0;
  finally
    FUpdate:= False;
  end;
end;

procedure TfrxFontComboBox.CNCommand(var Message:TWMCommand);
var
  pnt:TPoint;
  ind,i:integer;
  Reg:TRegistry;
begin
  inherited;
  if (Message.NotifyCode in [CBN_CLOSEUP]) then
  begin
    frFontViewForm.Visible:= False;
    ind:= itemindex;
    if (ItemIndex =-1) or (ItemIndex = 0) then exit;
    if FShowMRU then
    begin
      Items.BeginUpdate;
      if Items.IndexOf(Items[ind]) <= Numused then
      begin
        Items.Move(Items.IndexOf(Items[ind]), 0);
        ItemIndex:= 0;
      end else
      begin
        Items.InsertObject(0, Items[ItemIndex], Items.Objects[ItemIndex]);
        Itemindex:= 0;
        if Numused < 4 then
          Inc(Numused)
        else
          Items.Delete(5);
      end;
      Items.EndUpdate;
      Reg:= TRegistry.Create;
      try
        Reg.OpenKey(FRegKey,True);
        for i:= 0 to 4 do
          if i <= Numused then
          begin
           Reg.WriteString('Font'+IntToStr(i), Items[i]);
           Reg.WriteInteger('FontType'+IntToStr(i), Integer(Items.Objects[i]));
         end else
         begin
           Reg.WriteString('Font'+IntToStr(i), '');
           Reg.WriteInteger('FontType'+IntToStr(i), 0);
         end;
       finally
         Reg.Free;
       end;
    end;
  end;
  if (Message.NotifyCode in [CBN_DROPDOWN]) then
  begin
    if ItemIndex < 5 then
      PostMessage(FListHandle, LB_SETCURSEL, 0, 0);
    pnt.x:= (Self.Left )+Self.width;
    pnt.y:= (Self.Top )+Self.height;
    pnt:= Parent.ClientToScreen(pnt);
    frFontViewForm.Top:= pnt.y;
    frFontViewForm.Left:= pnt.x;

    if frFontViewForm.Left+frFontViewForm.Width > Screen.Width then
    begin
      pnt.x:= (Self.Left );
      pnt:= Parent.ClientToScreen(pnt);
      frFontViewForm.Left:= pnt.x-frFontViewForm.Width-1;
    end;
    if FUpDropdown then
    begin
      pnt.y:= (Self.Top );
      pnt:= Parent.ClientToScreen(pnt);
      frFontViewForm.Top:= pnt.y-frFontViewForm.Height;
    end;
    frFontViewForm.Visible:= True;
  end;
end;

{ TfrxFontPreview }

constructor TfrxFontPreview.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Width:= 200;
  Height:= 50;
  Visible:= False;
  Parent:= AOwner as TWinControl;

  FPanel:= TPanel.Create(Self);
  with FPanel do
  begin
    Parent:= Self;
    Color:= clWindow;
    Ctl3D:= False;
    ParentCtl3D:= False;
    BorderStyle:= bsSingle;
    BevelInner:= bvNone;
    BevelOuter:= bvNone;
    Font.Color:= clWindowText;
    Font.Size:= 18;
    Align:= alClient;
  end;
end;

destructor TfrxFontPreview.Destroy;
begin
  FPanel.Free;
  FPanel:= nil;
  inherited Destroy;
end;

procedure TfrxFontPreview.CreateParams(var Params:TCreateParams);
begin
  inherited CreateParams( Params);
    with Params do begin
      Style:= WS_POPUP or WS_CLIPCHILDREN;
      ExStyle:= WS_EX_TOOLWINDOW;
      WindowClass.Style:= WindowClass.Style or CS_SAVEBITS;
    end;
end;

{ TfrxComboEdit }

constructor TfrxComboEdit.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  Style:= csSimple;
  Height:= 21;
  FPanel:= TPanel.Create(Self);
  FPanel.Parent:= Self;
  FPanel.SetBounds(Width-Height+2, 2, Height-4, Height-4);
  FButton:= TSpeedButton.Create(Self);
  FButton.Parent:= FPanel;
  FButton.SetBounds(0, 0, FPanel.Width, FPanel.Height);
  FButton.OnClick:= ButtonClick;
  FButtonEnabled:= True;
end;

procedure TfrxComboEdit.SetPos;
begin
  SetWindowPos(EditHandle, 0, 0, 0, Width-Height-4, ItemHeight,
    SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE)
end;

procedure TfrxComboEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetPos;
end;

procedure TfrxComboEdit.WMSize(var Message:TWMSize);
begin
  inherited;
  FPanel.SetBounds(Width-Height+2, 2, Height-4, Height-4);
end;

procedure TfrxComboEdit.CMEnabledChanged(var Message:TMessage);
begin
  inherited;
  FButton.Enabled:= Enabled;
end;

procedure TfrxComboEdit.KeyPress(var Key:Char);
begin
  if (Key = Char(vk_Return)) or (Key = Char(vk_Escape)) then
    GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
  inherited KeyPress(Key);
end;

function TfrxComboEdit.GetGlyph:TBitmap;
begin
  Result:= FButton.Glyph;
end;

procedure TfrxComboEdit.SetGlyph(Value:TBitmap);
begin
  FButton.Glyph:= Value;
end;

function TfrxComboEdit.GetButtonHint:String;
begin
  Result:= FButton.Hint;
end;

procedure TfrxComboEdit.SetButtonHint(Value:String);
begin
  FButton.Hint:= Value;
end;

procedure TfrxComboEdit.SetButtonEnabled(Value:Boolean);
begin
  FButtonEnabled:= Value;
  FButton.Enabled:= Value;
end;

procedure TfrxComboEdit.ButtonClick(Sender:TObject);
begin
  SetFocus;
  if Assigned(FOnButtonClick) then
    FOnButtonClick(Self);
end;

{ TfrxScrollWin }

constructor TfrxScrollWin.Create(AOwner:TComponent);
begin
  inherited;
  FSmallChange:= 1;
  FLargeChange:= 10;
end;

procedure TfrxScrollWin.CreateParams(var Params:TCreateParams);
begin
  inherited;
  Params.ExStyle:= Params.ExStyle or WS_EX_CLIENTEDGE;
  Params.Style:= Params.Style or WS_CLIPCHILDREN or WS_HSCROLL or WS_VSCROLL;
end;

procedure TfrxScrollWin.WMEraseBackground(var Message:TMessage);
begin
end;

procedure TfrxScrollWin.WMGetDlgCode(var Message:TWMGetDlgCode);
begin
  Message.Result:= DLGC_WANTARROWS or DLGC_WANTTAB or DLGC_WANTALLKEYS;
end;

function TfrxScrollWin.GetLongPosition(DefValue:Integer; Code:Word):Integer;
var
  ScrollInfo:TScrollInfo;
begin
  ScrollInfo.cbSize:= SizeOf(TScrollInfo);
  ScrollInfo.fMask:= SIF_TRACKPOS;
  Result:= DefValue;
  if FlatSB_GetScrollInfo(Handle, Code, ScrollInfo) then
    Result:= ScrollInfo.nTrackPos;
end;

procedure TfrxScrollWin.SetHorzPage(const Value:Integer);
begin
  FHorzPage:= Value;
  HorzRange:= HorzRange;
end;

procedure TfrxScrollWin.SetHorzPosition(Value:Integer);
begin
  if Value > FHorzRange-FHorzPage then
    Value:= FHorzRange-FHorzPage;
  if Value < 0 then
    Value:= 0;
  if Value<>FHorzPosition then
  begin
    FHorzPosition:= Value;
    SetPosition(Value, SB_HORZ);
    OnHScrollChange(Self);
  end;
end;

procedure TfrxScrollWin.SetHorzRange(Value:Integer);
begin
  FHorzRange:= Value;
  UpdateScrollBar(Value, HorzPage, HorzPosition, SB_HORZ);
end;

procedure TfrxScrollWin.SetVertPage(const Value:Integer);
begin
  FVertPage:= Value;
  VertRange:= VertRange;
end;

procedure TfrxScrollWin.SetVertPosition(Value:Integer);
begin
  if Value > FVertRange-FVertPage then
    Value:= FVertRange-FVertPage;
  if Value < 0 then
    Value:= 0;
  if Value<>FVertPosition then
  begin
    FVertPosition:= Value;
    SetPosition(Value, SB_VERT);
    OnVScrollChange(Self);
  end;
end;

procedure TfrxScrollWin.SetVertRange(Value:Integer);
begin
  FVertRange:= Value;
  UpdateScrollBar(Value, VertPage, VertPosition, SB_VERT);
end;

procedure TfrxScrollWin.SetPosition(Value:Integer; Code:Word);
begin
  FlatSB_SetScrollPos(Handle, Code, Value, True);
end;

procedure TfrxScrollWin.UpdateScrollBar(Max, Page, Pos:Integer; Code:Word);
var
  ScrollInfo:TScrollInfo;
begin
  ScrollInfo.cbSize:= SizeOf(ScrollInfo);
  ScrollInfo.fMask:= SIF_ALL;
  ScrollInfo.nMin:= 0;
  if Max < Page then
    Max:= 0;
  ScrollInfo.nMax:= Max;
  ScrollInfo.nPage:= Page;
  ScrollInfo.nPos:= Pos;
  ScrollInfo.nTrackPos:= Pos;
  FlatSB_SetScrollInfo(Handle, Code, ScrollInfo, True);
end;

procedure TfrxScrollWin.Paint;
begin
  with Canvas do
  begin
    Brush.Color:= Color;
    FillRect(Rect(0, 0, ClientWidth, ClientHeight));
  end;
end;

procedure TfrxScrollWin.WMHScroll(var Message:TWMHScroll);
begin
  case Message.ScrollCode of
    SB_LINEUP:HorzPosition:= HorzPosition-FSmallChange;
    SB_LINEDOWN:HorzPosition:= HorzPosition+FSmallChange;
    SB_PAGEUP:HorzPosition:= HorzPosition-FLargeChange;
    SB_PAGEDOWN:HorzPosition:= HorzPosition+FLargeChange;
    SB_THUMBPOSITION, SB_THUMBTRACK:
      HorzPosition:= GetLongPosition(Message.Pos, SB_HORZ);
    SB_TOP:HorzPosition:= 0;
    SB_BOTTOM:HorzPosition:= HorzRange;
  end;
end;

procedure TfrxScrollWin.WMVScroll(var Message:TWMVScroll);
begin
  case Message.ScrollCode of
    SB_LINEUP:VertPosition:= VertPosition-FSmallChange;
    SB_LINEDOWN:VertPosition:= VertPosition+FSmallChange;
    SB_PAGEUP:VertPosition:= VertPosition-FLargeChange;
    SB_PAGEDOWN:VertPosition:= VertPosition+FLargeChange;
    SB_THUMBPOSITION, SB_THUMBTRACK:
      VertPosition:= GetLongPosition(Message.Pos, SB_VERT);
    SB_TOP:VertPosition:= 0;
    SB_BOTTOM:VertPosition:= VertRange;
  end;
end;

procedure TfrxScrollWin.OnHScrollChange(Sender:TObject);
begin
end;

procedure TfrxScrollWin.OnVScrollChange(Sender:TObject);
begin
end;

end.